home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 023a / adrsbar.zip / ADRSBAR.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-28  |  8KB  |  401 lines
  1. program ADRSBAR; {Based on POSTNT by Dave Barrett}
  2.  
  3. { Date: 06-12-91 }
  4.  
  5. (*********************************************************************)
  6. (* POSTNT was written as an exercise. The intent was to produce      *)
  7. (* a program which could print US Postal Service POSTNET barcodes    *)
  8. (* (those lines on lower right corner of some of the letters         *)
  9. (* you get in the mail) which could be used for demonstration        *)
  10. (* and information purposes. As it turned out, the barcodes          *)
  11. (* actually are 'readable' on a barcode sorter.                      *)
  12. (*                                                                   *)
  13. (*                                                                   *)
  14. (* This program was written by Dave Barrett, CS 76314,1004           *)
  15. (* This program is put in the public domain with the following       *)
  16. (* conditions:                                                       *)
  17. (*                                                                   *)
  18. (* 1) This portion of the documentation must remain with the source. *)
  19. (* 2) If you make any improvements to the program please post them   *)
  20. (*    so others can enjoy them.                                      *)
  21. (* 3) This program must be distributed without charge whether used   *)
  22. (*    alone or included as part of another program.                  *)
  23. (* 4) Please include the accompanying file POSTNT.DOC along with     *)
  24. (*    this file                                                      *)
  25. (*********************************************************************)
  26.  
  27.  
  28.  
  29. uses dos,crt,printer,adrsprn;
  30.  
  31. type
  32.  NumberSet = set of char;
  33.  
  34. var
  35.  infile : text;
  36.  Infilename : string[30];
  37.  CheckDigit,
  38.  ZIPString : string[200];
  39.  Afield,
  40.  Bfield : string [10];
  41.  Numbers : NumberSet;
  42.  Count,Firstcount,Lastcount,
  43.  CheckNumber,
  44.  result : integer;
  45.  ExitSave : pointer;
  46.  
  47.  ZIPCodeIsValid : boolean;
  48.  
  49. procedure PrintFullBar;
  50. begin
  51.  Write(Lst,char(255));
  52.  Write(Lst,char(255));
  53.  Write(Lst,char(255));
  54.  Write(Lst,char(255));
  55. end;
  56.  
  57. procedure PrintFullSpace;
  58. begin
  59.  Write(Lst,char(0));
  60.  Write(Lst,char(0));
  61.  Write(Lst,char(0));
  62.  Write(Lst,char(0));
  63.  Write(Lst,char(0));
  64.  Write(Lst,char(0));
  65.  Write(Lst,char(0));
  66.  Write(Lst,char(0));
  67. end;
  68.  
  69. procedure PrintPartSpace;
  70. begin
  71.  Write(Lst,char(0));
  72.  Write(Lst,char(0));
  73.  Write(Lst,char(0));
  74.  Write(Lst,char(0));
  75.  Write(Lst,char(0));
  76.  Write(Lst,char(0));
  77.  Write(Lst,char(0));
  78. end;
  79.  
  80. procedure PrintHalfBar;
  81. begin
  82.  Write(Lst,char(15));
  83.  Write(Lst,char(15));
  84.  Write(Lst,char(15));
  85.  Write(Lst,char(15));
  86. end;
  87.  
  88. procedure PrintFrameBar;
  89. begin
  90.  PrintFullBar;
  91.  PrintFullSpace;
  92. end;
  93.  
  94. procedure Print0;
  95. begin
  96.  PrintFullBar;
  97.  PrintFullSpace;
  98.  PrintFullBar;
  99.  PrintPartSpace;
  100.  PrintHalfBar;
  101.  PrintFullSpace;
  102.  PrintHalfBar;
  103.  PrintPartSpace;
  104.  PrintHalfBar;
  105.  PrintFullSpace;
  106. end;
  107.  
  108. procedure Print1;
  109. begin
  110.  PrintHalfBar;
  111.  PrintFullSpace;
  112.  PrintHalfBar;
  113.  PrintPartSpace;
  114.  PrintHalfBar;
  115.  PrintFullSpace;
  116.  PrintFullBar;
  117.  PrintPartSpace;
  118.  PrintFullBar;
  119.  PrintFullSpace;
  120. end;
  121.  
  122. procedure Print2;
  123. begin
  124.  PrintHalfBar;
  125.  PrintFullSpace;
  126.  PrintHalfBar;
  127.  PrintPartSpace;
  128.  PrintFullBar;
  129.  PrintFullSpace;
  130.  PrintHalfBar;
  131.  PrintPartSpace;
  132.  PrintFullBar;
  133.  PrintFullSpace;
  134. end;
  135.  
  136. procedure Print3;
  137. begin
  138.  PrintHalfBar;
  139.  PrintFullSpace;
  140.  PrintHalfBar;
  141.  PrintPartSpace;
  142.  PrintFullBar;
  143.  PrintFullSpace;
  144.  PrintFullBar;
  145.  PrintPartSpace;
  146.  PrintHalfBar;
  147.  PrintFullSpace;
  148. end;
  149.  
  150. procedure Print4;
  151. begin
  152.  PrintHalfBar;
  153.  PrintFullSpace;
  154.  PrintFullBar;
  155.  PrintPartSpace;
  156.  PrintHalfBar;
  157.  PrintFullSpace;
  158.  PrintHalfBar;
  159.  PrintPartSpace;
  160.  PrintFullBar;
  161.  PrintFullSpace;
  162. end;
  163.  
  164. procedure Print5;
  165. begin
  166.  PrintHalfBar;
  167.  PrintFullSpace;
  168.  PrintFullBar;
  169.  PrintPartSpace;
  170.  PrintHalfBar;
  171.  PrintFullSpace;
  172.  PrintFullBar;
  173.  PrintPartSpace;
  174.  PrintHalfBar;
  175.  PrintFullSpace;
  176. end;
  177.  
  178. procedure Print6;
  179. begin
  180.  PrintHalfBar;
  181.  PrintFullSpace;
  182.  PrintFullBar;
  183.  PrintPartSpace;
  184.  PrintFullBar;
  185.  PrintFullSpace;
  186.  PrintHalfBar;
  187.  PrintPartSpace;
  188.  PrintHalfBar;
  189.  PrintFullSpace;
  190. end;
  191.  
  192. procedure Print7;
  193. begin
  194.  PrintFullBar;
  195.  PrintFullSpace;
  196.  PrintHalfBar;
  197.  PrintPartSpace;
  198.  PrintHalfBar;
  199.  PrintFullSpace;
  200.  PrintHalfBar;
  201.  PrintPartSpace;
  202.  PrintFullBar;
  203.  PrintFullSpace;
  204. end;
  205.  
  206. procedure Print8;
  207. begin
  208.  PrintFullBar;
  209.  PrintFullSpace;
  210.  PrintHalfBar;
  211.  PrintPartSpace;
  212.  PrintHalfBar;
  213.  PrintFullSpace;
  214.  PrintFullBar;
  215.  PrintPartSpace;
  216.  PrintHalfBar;
  217.  PrintFullSpace;
  218. end;
  219.  
  220. procedure Print9;
  221. begin
  222.  PrintFullBar;        { 4 }
  223.  PrintFullSpace;      { 8 }
  224.  PrintHalfBar;        { 4 }
  225.  PrintPartSpace;      { 7 }
  226.  PrintFullBar;        { 4 }
  227.  PrintFullSpace;      { 8 }
  228.  PrintHalfBar;        { 4 }
  229.  PrintPartSpace;      { 7 }
  230.  PrintHalfBar;        { 4 }
  231.  PrintFullSpace;      { 8 }
  232. end;
  233.  
  234. procedure PrintBarCode(s:integer);
  235. var
  236.  i : integer;
  237. begin
  238.  PrintFrameBar;
  239.  i:=1;
  240.  while i <= Length(ZIPString) do
  241.   begin
  242.    case ZIPString[i] of
  243.     '0':Print0;
  244.     '1':Print1;
  245.     '2':Print2;
  246.     '3':Print3;
  247.     '4':Print4;
  248.     '5':Print5;
  249.     '6':Print6;
  250.     '7':Print7;
  251.     '8':Print8;
  252.     '9':Print9;
  253.    end;
  254.    i:=i+1;
  255.   end;
  256.  PrintFrameBar;
  257.  if s=1 then
  258.   else
  259.    Writeln(Lst);
  260. end;
  261.  
  262. procedure DetermineCheckDigit;
  263. var
  264.  zip_digit,
  265.  zip_total,
  266.  i : integer;
  267. begin
  268.  zip_total:=0;
  269.  for i:=1 to Length(ZIPString) do
  270.   begin
  271.    Val(ZIPString[i],zip_digit,result);
  272.    zip_total:=zip_total+zip_digit;
  273.   end;
  274.  CheckNumber:=10 - (zip_total MOD 10);
  275.  Str(CheckNumber:1,CheckDigit);
  276.  ZIPString:=ZIPString+CheckDigit;
  277. end;
  278.  
  279. procedure VerifyDigits;
  280. var
  281.  i : integer;
  282. begin
  283.  Numbers:=['0','1','2','3','4','5','6','7','8','9'];
  284.  ZIPCodeIsValid:=true;
  285.  if ((Copy(ZIPString,1,1)='A') OR (Copy(ZIPString,1,1)='a'))
  286.     AND ((Copy(ZIPString,2,1)='B') OR (Copy(ZIPString,2,1)='b'))
  287.     AND (Length(ZIPString)=13) then
  288.   ZIPString:=Copy(ZIPString,3,11);
  289.  if (Length(ZIPString)=5) then
  290.   begin
  291.    for i:=1 to 5 do
  292.     if ZIPString[i] in Numbers then
  293.      begin end
  294.     else
  295.      ZIPCodeIsValid:=false;
  296.   end
  297.  else
  298.   if (Length(ZIPString)=9) then
  299.    begin
  300.     for i:=1 to 9 do
  301.      if ZIPString[i] in Numbers then
  302.       begin end
  303.      else
  304.       ZIPCodeIsValid:=false;
  305.    end
  306.   else
  307.    if (Length(ZIPString)=10) AND (Pos('-',ZIPString)=6) then
  308.     begin
  309.      Delete(ZIPString,6,1);
  310.      for i:=1 to 9 do
  311.       if ZIPString[i] in Numbers then
  312.        begin end
  313.       else
  314.        ZIPCodeIsValid:=false;
  315.     end
  316.    else
  317.     if (Length(ZIPString)=11) then
  318.      begin
  319.       for i:=1 to 11 do
  320.        if ZIPString[i] in Numbers then
  321.         begin end
  322.        else
  323.         ZIPCodeIsValid:=false;
  324.      end
  325.     else
  326.      ZIPCodeIsValid:=false;
  327. end;
  328.  
  329. procedure PrintAddress;  {This section added by R.B. Shreve, W8GRG, 6/12/91}
  330. begin
  331.    WriteLn(Lst,FirstName+' '+LastName);     {from ADRSPRN.PAS}
  332.    WriteLn(Lst,Address);
  333.    WriteLn(Lst,City+' '+State+' '+Zip)
  334. end;
  335.  
  336. procedure Initialization;
  337. begin
  338.    Clrscr;
  339.    GotoXY(10,5);
  340.    Write('Enter name of address file..');   {modification by R.B. Shreve to}
  341.    Read(infilename);                        {read address from ASCII list..}
  342.    Assign(infile, infilename);
  343. {$I-}
  344.    Reset(infile);
  345. {$I+}
  346.    If IOResult <> 0 then WriteLn('File not found');
  347.    GotoXY(10,7);
  348.    Write('Enter starting record number...');    {permits printing part of file}
  349.    ReadLn(Firstcount);
  350.    GotoXY(10,8);
  351.    Write('Enter ending record number...');
  352.    ReadLn(Lastcount);
  353. end;
  354.  
  355. {$F+}
  356. procedure MyExit;
  357. begin
  358.     ExitProc:=ExitSave;
  359.     gotoXY(12,12);
  360.     WriteLn('End of File');
  361.     Close(infile);
  362. end;
  363. {$F-}
  364.  
  365. begin
  366.  ZIPString:='';
  367.  Count:=1;
  368.  Initialization;
  369.  While not EOF(infile) do
  370.  begin
  371.    if (count>=firstcount) and (count<=lastcount) then
  372.    begin
  373.  
  374.       GetAdr(infile);
  375.       ZIPString:=Zip;
  376.       VerifyDigits;
  377.       if ZIPCodeIsValid then
  378.       begin
  379.            PrintAddress;
  380.            DetermineCheckDigit;
  381.            if Length(ZIPSTring) = 6 then
  382.               Write(Lst,char(27),'Z',char(116),char(1))
  383.            else
  384.               Write(Lst,char(27),'Z',char(92),char(2));
  385.  
  386.            PrintBarCode(0);       { CR/LF ok }
  387.            WriteLn(Lst,char(27),'I',2);
  388.            WriteLn(Lst);
  389.       end;
  390.    end;
  391.    Inc(count);
  392.  if count>lastcount then
  393.  begin
  394.  
  395.     Halt;
  396.     ExitSave:=ExitProc;
  397.     ExitProc:=@MyExit;
  398.  end;
  399.  end;
  400. end.
  401.